module reverse_polish_mod
   use stack_mod
   implicit none
   type(stack)::expr,oper
   character(len=*),parameter::opera="+-*/()^"
contains
   real(8)function eval(str)result(res)
      character(len=*),intent(in)::str
      call reverse_polish(str)
      res=calc_polish()
   end function eval

   function oper_max(str)result(f1)
      character(len=*),intent(in)::str
      integer::f1
      select case(trim(adjustl(str)))
      case("+","-")                 ; f1=1
      case("*","/")                 ; f1=2
      case("^")                     ; f1=4
      case("sin","cos","tan","exp") ; f1=5
      case(")")                     ; f1=10
      case("(")                     ; f1=0
      case default                  ; f1=-1
      end select
   end function oper_max

   subroutine reverse_polish(str)
      character(len=*),intent(in)::str
      integer::op,opold
      character(len=:),allocatable::s1,ops
      integer::head,pos,oper_length
      head=1
      do
         pos=scan(str(head:),opera)+head-1
         s1=str(head:pos-1)
         if(s1/=" ") then
            if(oper_max(s1)/=5) then
               call expr%push(s1)
               ops=str(pos:pos)
               oper_length=1
            else
               call expr%push("1")
               ops=trim(adjustl(s1))
               oper_length=0
            end if
         else
            ops=str(pos:pos)
            oper_length=1
         end if
         op=oper_max(ops)
         if(op==10)then
            do
               s1=oper%pop()
               if(s1=="(")exit
               call expr%push(s1)
            end do
         else
            if(op>0.and.op<10)then
               opold=oper_max(oper%get())
               if(opold>=op)then
                  do
                     s1=oper%pop()
                     if(oper_max(s1)<op)exit
                     call expr%push(s1)
                  end do
                  call oper%push(s1)
               end if
            end if
            call oper%push(ops)
         end if
         head=pos+oper_length
         if(head>len_trim(str))exit
      end do
   end subroutine reverse_polish

   real(8) function calc_polish()result(res)
      real(8)::r1,r2
      character(len=80)::e1,s1
      call expr%reverse()
      do while(.not.expr%empty())
         s1=expr%pop()
         e1=""
         select case(s1)
         case("+","-","*","/","^","sin","cos","tan","exp")
            r1=to_real(oper%pop())
            r2=to_real(oper%pop())
            select case(s1)
            case("+")   ; write(e1,"(g0)")r1+r2
            case("-")   ; write(e1,"(g0)")r2-r1
            case("*")   ; write(e1,"(g0)")r1*r2
            case("/")   ; write(e1,"(g0)")r2/r1
            case("^")   ; write(e1,"(g0)")r2**r1
            case("sin") ; write(e1,"(g0)")sin(r1)
            case("cos") ; write(e1,"(g0)")cos(r1)
            case("tan") ; write(e1,"(g0)")tan(r1)
            case("exp") ; write(e1,"(g0)")exp(r1)
            end select
            call oper%push(e1)
         case default
            call oper%push(s1)
         end select
      end do
      res=to_real(oper%pop())
   end function calc_polish

   real(8) function to_real(str) result(f1)
      character(len=*),intent(in)::str
      read(str,*)f1
   end function to_real
end module reverse_polish_mod
